perm filename S3.F4[LX,LCS] blob
sn#169956 filedate 1975-07-25 generic text, type T, neo UTF8
00100 C SCORB.F4 2ND HALF OF SCORE.
00200 SUBROUTINE RUNIT
00300 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00400 1 ,LN,ITYP,TPALN,JED
00500 COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700 1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800 1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900 DIMENSION IV(2000),IT(30),IOUT(70),JPT(837),NCNT(27,32)
00910 1,COFF1(27),COFF2(27),RREST(27)
01000 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
01100 C 40 LIT CHARS + 30 PARAMS PER INST.
01200 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
01300 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500 1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700 1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800 1 ZZ,CHN,YY
01900 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000 1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
02200 1 KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,RD,
02300 1 VIJ2
02400 C /C/=26
02500 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
02600 1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
02700 1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
02800 1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
02900 1 ,(IT,INP(28)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
03000 1 ,(IFM4,IFM(4)),(COFF1,INP(58)),(COFF2,INP(85))
03010 1 ,(RREST,INP(112))
03100 DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03200 1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03300 1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
03400 1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
03500 1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
03600 1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
03700 1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
03800 1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
03900 1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
04000 1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04100 1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
04200 1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
04300 PR=0
04310 DO 9337 K=1,27
04320 COFF1(K)=0
04330 9337 RREST(K)=0
04340 C ZEROS CUTOFF AND RAND REST STORAGE
04400 2337 T=0
04500 DO 1107 K=1,30
04600 1107 PL(K)=1.
04700 C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
04800 IF(ITYP)GO TO 23371
04900 END FILE 21
05000 DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
05100 TYPE ENFI
05200 C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
05300 23371 IF(SOS)WRITE(JOUT,902)
05400 C WRITES A BLANK LINE
05500 NWZZ=0
05600 IAMP=0
05700 IT3=0
05800 K=1
05900 IX=0
06000 BG(NINS+1)=19999.
06100 4011 IF(CNT(K))GO TO 5011
06200 6011 IF(K.EQ.KZY)GO TO 4337
06300 K=K+1
06400 GO TO 4011
06500 5011 L=V(I-1)/(-9900.)
06600 IF(L.EQ.1)I=I-1
06700 V(I)=CNT(K)
06800 V(I+1)=P(K)
06900 V(I+3)=-44.
07000 I=I+5
07100 IF(P(K).EQ.980000.)I=I-4
07200 KL=I
07300 REWIND 1
07400 ICT=IPT(K,1)
07500 CALL IFILE(1,ICT)
07600 9011 L=I+6
07700 READ(1,7011)(V(M),M=I,L)
07800 C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
07900 IF(V(L).EQ.999.)GO TO 8011
08000 I=L+1
08100 GO TO 9011
08200 8011 IF(P(K).NE.980000.)GO TO 6337
08300 DO 7337 K=L,I,-1
08400 7337 IF(V(K).NE.999.)GO TO 8337
08500 8337 I=K-1
08600 V(I)=0
08700 V(I+1)=V(K)
08800 V(I+2)=V(K)
08900 C K WAS I-1 ABOVE.
09000 I=I+3
09100 V(KL+1)=I-KL-1
09200 C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
09300 GO TO 4337
09400 6337 DO 5337 M=I,L
09500 KN=M
09600 5337 IF(V(M).EQ.999.)GO TO 3337
09700 3337 I=KN
09800 KN=I-KL
09900 V(KL-1)=KN
10000 V(KL-3)=KN+3
10100 GO TO 6011
10200 7011 FORMAT(7F)
10300 4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
10400 V(I)=-19899.
10500 PP1=0
10600 T6=10000.
10700 DO 2118 K=1,NINS
10800 ROFF(K)=0
10900 C********* FEB 17,71
11000 M=NP(K)
11100 IT(K)=0
11200 IPT(K,31)=0
11300 NCNT(K,31)=1
11400 DO 2118 L=1,M
11500 NCNT(K,L)=1
11600 2118 IPT(K,L)=0
11700 DO 5013 K=1,IXIN
11800 5013 X=RAND(0.0,0.0)
11900 REWIND 1
12000 IF(MX)CALL OFILE(1,ISLAC)
12100 NW=1
12200 NWX=0
12300 TDUR=0
12400 A=0
12500 T2=1.
12600 T4=1.
12700 T5=0
12800 J=1
12900 MK=0
13000 C IS THE ABOVE NEEDED?
13100 IF(MX.NE.3)GO TO 40021
13200 K=4
13300 10023 N=AMOD(V(K),100.0)/-11.
13400 C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
13500 IF(N.EQ.2)GO TO 77
13600 IF(N.EQ.3)GO TO 77
13700 IF(N.NE.4)GO TO 10021
13800 77 IF(V(K-2).LT.10000.)GO TO 10021
13900 J=V(K+1)
14000 IF(J.EQ.1)GO TO 10024
14100 IF(N.NE.3)GO TO 177
14200 IF(V(K+J+1).EQ.101.)J=J-1
14300 177 N=V(K-2)
14400 L=N/10000
14500 M=N-L*10000
14600 TYPE 10022,INST(L),M,J
14700 10024 K=K+ABS(V(K-1))
14800 10021 K=K+1
14900 IF(K.LT.I)GO TO 10023
15000 40021 IF(MZ.NE.-4)GO TO 1002
15100 N=1
15200 40022 K=N+1
15300 IF(N.GT.I)CALL EXIT
15400 X=V(N)
15500 IF(X.EQ.-199.)GO TO 40024
15600 IF(X.EQ.-99.)GO TO 40024
15700 IF(X.GE.0)GO TO 40023
15800 PRINT 4002,X
15900 N=N+1
16000 GO TO 40022
16100 40024 J=N+1
16200 GO TO 40025
16300 C FOR 'SECTIONS'
16400 40023 J=ABS(V(K))+K-1
16500 40025 PRINT 4002,(V(K),K=N,J)
16600 N=J+1
16700 GO TO 40022
16800 10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
16900 4002 FORMAT(10F12.3)
17000 1002 IF(IDALL)GO TO 600
17100 X=DUR(IDALL)
17200 DO 2002 K=1,NINS
17300 2002 IF(DUR(K))DUR(K)=X
00100 C ***** SORTER *************************
00200 C ******* OUTPUT LOOP FROM HERE ON ********
00300 600 IL=0
00400 C********** BELOW IS FOR 'SECTIONS'
00500 KODE=0
00600 NWX=NWX+1
00700 MK=MK+1
00800 Y=BNW(NW)
00900 723 IL=IL+1
01000 3723 Z=V(IL)
01100 IF(Z.EQ.-19899.)GO TO 732
01200 IF(Z.NE.-9900.-Y)GO TO 723
01300 C********** BELOW IS FOR 'SECTIONS'
01400 IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500 2723 IL=IL+1
01600 729 K=IL+2
01700 MOT=V(IL+1)
01800 RD=V(K)
01900 IF(RD.EQ.-67.)GO TO 3726
02000 RB=V(IL)
02100 C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200 IF(RB.NE.-99.)GO TO 4150
02300 KODE=IV(K-1)
02400 2160 IF(KODE.EQ.0)GO TO 723
02500 IF(MZ)WRITE(JOUT,9150),KODE
02600 KL=Y/10000.
02700 RB=Y+KL*10000.
02800 DO 5150 KL=1,I
02900 IF(V(KL).NE.-199.)GO TO 5150
03000 IF(IV(KL+1).NE.KODE)GO TO 5150
03100 IV(K-1)=0
03200 C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03300 RD=V(KL+2)+9900.
03400 DO 6150 L=KL+2,I
03500 M=V(L)/(-9900.)
03600 IF(M.NE.1)GO TO 6150
03700 RA=RB+RD-V(L)-9900.
03800 V(L)=-9900.-RA
03900 C UPDATES BG TIMES INSIDE SECTION.
04000 CALL BGSORT(RA)
04100 C7150 IF(RA.EQ.BNW(KA))GO TO 6150
04200 C UPDATES LIST OF CHANGE TIMES.
04300 6150 IF(V(L).EQ.-299.)GO TO 160
04400 5150 CONTINUE
04500 160 IL=1
04600 GO TO 3723
04700 C*********** ABOVE IS FOR 'SECTION' REPEATS
04800 4150 LK=RB/10000.+.2
04900 IF(LK.GE.98)GO TO 7700
05000 LP=RB-LK*10000
05100 C LK=INST # LP=PARAM #
05200 LN=IPT(LK,LP)
05300 IPT(LK,LP)=IL+2
05400 IF(RD.EQ.-66.)GO TO 726
05500 IF(RD.EQ.-55.)GO TO 1726
05600 IF(RD.EQ.-56.)GO TO 1726
05700 IF(RD.EQ.-23)GO TO 6700
05800
05900 2727 ML=IPT(LK,LP)
06000 IF(MOT.GT.0)GO TO 3727
06100 C USE NEG WDCNT FOR 'ALL'
06200 DO 4727 KL=LK+1,NINS
06300 IF(NP(KL).GE.LP)GO TO 277
06400 IF(LP.LT.31)NP(KL)=LP
06500 277 IPT(KL,LP)=-(LK+(LP-1)*KZY)
06600 NCNT(KL,LP)=10000
06700 4727 IF(DUR(KL))DUR(KL)=1000.
06800 C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06900 C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
07000 GO TO 727
07100 C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07200 3727 IF(V(IL).NE.V(LN-1))GO TO 727
07300 IF(LN.EQ.0)GO TO 727
07400 DO 1727 L=1,NINS
07500 DO 1727 KL=1,NP(L)
07600 IF(LN.NE.IPT(L,KL))GO TO 1727
07700 NCNT(L,KL)=10000
07800 C ******* JAN 29,70
07900 IPT(L,KL)=ML
08000 C RESETS POINTERS FOR DUPL AND REP INSTS.
08100 C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08200 1727 CONTINUE
08300 727 NCNT(LK,LP)=10000
08400 C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08500 2150 IF(MOT)MOT=-MOT
08600 IL=IL+MOT+1
08700 3150 IF(V(IL))GO TO 3723
08800 GO TO 729
08900 726 RB=V(IL+3)
09000 K=RB/10000.
09100 L=RB-K*10000
09200 IPT(LK,LP)=-(K+(L-1)*KZY)
09300 GO TO 2727
09400 3726 LK=V(IL)
09500 M=V(K+1)
09600 KL=NP(M)
09700 DO 4726 L=1,KL
09800 IPT(LK,L)=IPT(M,L)
09900 IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
10000 C****** JUN 29 71 (LK,L) WAS (L,K)....???????
10100 4726 CONTINUE
10200 IPT(LK,31)=IPT(M,31)
10300 K=0
10400 GO TO 2150
10500 C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
10600 6700 KL=IL+V(IL+1)+1.3
10700 RC=V(K-2)
10800 1770 IF(V(KL))GO TO 700
10900 2700 KL=KL+V(KL+1)+1.3
11000 GO TO 1770
11100 700 KL=KL+1
11200 IF(Z.NE.V(KL-1))GO TO 2700
11300 IF(V(KL).NE.RC)GO TO 2700
11400 KL=KL+3
11500 KN=IL+3
11600 LN=V(KN)+.3
11700 DO 3700 L=1,LN,2
11800 RA=V(L+KN)
11900 KA=V(L+KN+1)+.3
12000 RB=0
12100 DO 4700 LP=1,KA
12200 4700 RB=RB+V(KL+LP)
12300 DO 5700 LP=1,KA
12400 5700 V(KL+LP)=V(KL+LP)/RB*RA
12500 V(KL+KA)=V(KL+KA)+.00030
12600 3700 KL=KL+KA
12700 GO TO 2150
12800
12900 C BELOW FOR 'TEMPO' SETUP
13000 7700 T2=V(IL+4)
13100 T1=V(IL+3)
13200 TBG=Y
13300 TDUR=V(IL+2)
13400 CALL SQYY(AC,T1,T2,TDUR)
13500 8700 IF(TDUR.EQ.0)TDUR=10000.
13600 T5=1.
13700 T6=TBG+TDUR
13800 IT3=1.
13900 IF(LK.EQ.98)IT3=IL+2
14000 T4=1.
14100 GO TO 2150
14200 C*************** ANY WDCNTS DOWN FROM HERE. *********
14300 C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400 1726 IF(V(IL-1).GT.-19000.)GO TO 2727
14500 RA=BT
14600 K=IL-1
14700 2726 V(K)=-9900.-RA
14800 ISUB=-1
14900 L=K+5
15000 RB=V(L)+V(L-1)
15100 V(L-1)=RA
15200 K=K+V(K+2)+2
15300 IF(V(K).GT.-19000.)GO TO 2727
15400 IF(V(K+1).NE.V(IL))GO TO 2727
15500 IF(V(K).NE.-9900.-RB)GO TO 2727
15600 RA=RA+V(L)
15700 CALL BGSORT(RA)
15800 GO TO 2726
15900 C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
16000 C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16100 732 DO 2606 K=NW,NWZ
16200 2606 BNW(K)=BNW(K+1)
16300 NWZ=NWZ-1
16400 IF(NWZ.EQ.0)GO TO 2111
16500 IF(NWZZ.EQ.1)GO TO 5111
16600 NWZZ=1
16700 IF(NWZ.EQ.1)GO TO 1111
16800 DO 3111 K=1,NWZ
16900 IF(BNW(K).LT.1000.)GO TO 3111
17000 X=BNW(NWZZ)
17100 BNW(NWZZ)=BNW(K)
17200 BNW(K)=X
17300 NWZZ=NWZZ+1
17400 3111 CONTINUE
17500 5111 IF(NWZZ.EQ.NWZ)GO TO 1111
17600 L=NWZZ+1
17700 X=BNW(NWZZ)
17800 DO 4111 K=L,NWZ
17900 IF(BNW(K).GT.X)GO TO 4111
18000 RA=BNW(K)
18100 BNW(K)=X
18200 X=RA
18300 4111 CONTINUE
18400 BNW(NWZZ)=X
18500 GO TO 1111
18600 111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18700 1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2/)
18800 1023 FORMAT(/' < ',A5,'.DAT -- RANDOM NUMBER=',I6/1XA5)
18900 C********** BELOW IS FOR 'SECTIONS'
19000 9150 FORMAT(/3X'******* SECTION ',A1)
19100 2111 NWZ=-1
19200 C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300 1111 IF(MZ.EQ.0)GO TO 1601
19400 IF(NWX.NE.1)GO TO 1486
19500 WRITE(JOUT,111)ISLAC,IFLNM,I,TF
19600 C*********** JUNE 1,71
19700 C********** BELOW IS FOR 'SECTIONS'
19800 1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900 K=NWX-1
20000 C*********** JUNE 1,71
20100 IF(NWX.LE.1)GO TO 377
20200 IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y
20300 377 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
20400 C*********** JUNE 1,71 X 3 K'S
20500
20600 DO 602 K=1,NINS
20700 48 LK=INST(K)
20800 C*********** JUNE 1,71
20900 IF(NCNT(K,31).EQ.10000)GO TO 477
21000 IF(NWX.GT.1)GO TO 602
21100 477 NCNT(K,31)=1
21200 IJ=IPT(K,31)
21300 X=0
21400 IF(IJ.NE.0)X=V(IJ+2)
21500 WRITE(JOUT,5396),LK,X
21600 X=DUR(K)
21700 IF(X.GT.10000.)GO TO 83
21800 WRITE(JOUT,8396),X
21900 GO TO 602
22000 5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
22100 7396 FORMAT('+',F5.0,' NOTES')
22200 8396 FORMAT('+',F6.2,'"')
22300 83 X=X-10000.
22400 WRITE(JOUT,7396),X
22500 602 CONTINUE
22600 715 IF(IT3.NE.1.)GO TO 1602
22700 RA=T1*TP
22800 RB=T2*TP
22900 WRITE(JOUT,6154),RA,RB,TDUR
23000 IT3=0
23100 1602 IF(NWX.EQ.1)GO TO 315
23200 IF(IT(J).EQ.-3)GO TO 1108
23220 IT(J)=IT(J)/10
23230 GO TO 1108
23300 C*********** JUNE 1,71
23400 6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
23500 7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
23600 5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23700 902 FORMAT(1XA5/)
23800 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23900 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
24000 C*********** JUNE 1,71
24010 1715 FORMAT(' RCDFLG=-1;')
24300 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
24400 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
24500 1601 IF(NWX.GT.1) GO TO 1108
24600 IF(TF.GT.10.)TF=TF/60.
24700 TF=1000./TF
24800 DO 6015 K=1,30
24900 6015 COPY(K)=-9900.
25000 C INITS PARAM REPRESSION FEATURE.
25010 IF(MZ)WRITE(JOUT,1715)
25020 IF(MX)WRITE(1,1715)
25030 C 7/75 NOW WRITES 'RCDFLG=-1;' BEFORE! ANY INSERTS AND 'PLAY'.
25100 IF(KB.EQ.0)GO TO 9926
25200 ML=NINS+1
25300 NL=NINS+KB
25400 DO 9826 K=ML,NL
25500 BW=OTH(K-NINS,1)
25600 IF(BW.NE.-99)GO TO 9826
25700 K=K-NINS
25800 GO TO 5741
25900 C 'INSERT -99;' COMES BEFORE 'PLAY;'
26000 9726 BW=19999.
26100 K=K+NINS
26200 9826 BG(K)=BW
26300 C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
26400 9926 DO 5015 K=1,NINS
26500 IQ(K)=BG(K)*10000.
26600 BG(K)=0
26700 INP(K)=0
26800 P1(K)=0
26900 IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
27000 C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
27100 5015 CNT(K)=0
27200 IF(MZ)WRITE(JOUT,1023),ISLAC,IXIN,PLAY
27300 IF(MX)WRITE(1,1023)ISLAC,IXIN,PLAY
27400 BW=0
27500 GO TO 500
00100 752 FORMAT(1X15A5)
00200 1108 M=0
00300 JC=0
00400 IF(NWZ)GO TO 1740
00500 C NWZZ IS SET AT 3111 IN SORTR.
00600 DO 740 K=1,NWZZ
00700 X=BNW(K)
00800 IF(X-.0001.GT.BT)GO TO 2740
00900 IF(X.LE.BW)GO TO 2740
01000 IF(BW)GO TO 2740
01100 IT(J)=IT(J)*10
01200 NW=K
01300 GO TO 600
01400 2740 IF(X.LT.1000.)GO TO 740
01500 IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
01600 X=BT+PR
01700 NW=K
01800 BX=CNT(J)+1.
01900 IT(J)=-3
02000 GO TO 600
02100 740 CONTINUE
02200 IT(J)=0
02300 1740 IF(J.LE.NINS)GO TO 31
02400 7021 K=J-NINS
02500 IF(JC.GT.0)K=JC
02600 5740 IF(PP1.LT.OP1)GO TO 1752
02700 5741 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
02800 IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
02900 C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
03000 C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
03100 DO 17521 L=3,30
03200 17521 COPY(L)=-9900.
03300 C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03400 1752 BG(K+NINS)=19999.
03500 OTH(K,1)=19999.
03600 IF(BW.EQ.-99)GO TO 9726
03700 IF(JC.GT.0)GO TO 21
03800 31 KL=1
03900 IF(KB.EQ.0)GO TO 2031
04000 DO 1031 L=1,KB
04100 K=L
04200 X=OTH(K,1)-1000000.
04300 M=X/100000.
04400 IF(M.NE.J)GO TO 1031
04500 IF(IQ(J).NE.0)GO TO 1031
04600 C M=INST
04700 IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
04800 1031 CONTINUE
04900 IF(J.GT.NINS)GO TO 500
05000 2031 CNT(J)=CNT(J)+1
05100 ICT=CNT(J)
05200 C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
05300 NPA=NP(J)
05400 PP1=P1(J)
05500 IF(BT.GE.DUR(J))GO TO 5174
05600 IF(IQ(J).EQ.0)GO TO 200
05700 P2=-IQ(J)/10000.
05800 IQ(J)=0
05900 CNT(J)=-1
06000 ICT=-1
06100 CC MK=-1
06200 C PRINTS REST AND CNT=-1 WHEN 1ST BG TIME IS >0
06300 GO TO 4203
06400
06500 C MK IS FLAG FOR RESTS
06600 200 MK=0
06700 IF(BT.NE.0)GO TO 577
06800 IF(J.EQ.1)GO TO 203
06900 577 IF(IPT(J,1).EQ.0)GO TO 203
07000 KN=IPT(J,1)-1
07100 IF(KN.GT.0)GO TO 12033
07200 12032 KN=JPT(-KN)
07300 IF(KN)GO TO 12032
07400 KN=KN-1
07500 C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
07600 C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
07700 12033 IJ=V(KN)
07800 IF(ABS(V(KN)).EQ.4.)GO TO 1203
07900 C 'IABS' IS FOR -4 USED WITH 'ALL'
08000 Z=(BT+9900.+V(KN-2))/V(KN+2)
08100 C******* FEB 19,71
08200 IF(Z.GT.1.)Z=1.
08300 Y=V(KN+3)
08400 X=(V(KN+4)-Y)*Z+Y
08500 C******* FEB 19,71
08600 GO TO 204
08700 1203 X=V(KN+3)
08800 204 Y=RAND(0.0,1.0)
08900 IF(Y-X)MK=-1
09000
09100 203 DF=1.
09200 C DF=DUTY FACTOR
09300 DO 2155 L=2,NPA
09400 ISUB=0
09500 C WHY DOES ISUB APPEAR AT 14700/5?
09600 IDF=0
09700 C IDF IS DUTY FACTOR FLAG
09800 IJ=IPT(J,L)
09900 12031 IF(IJ)IJ=JPT(-IJ)
10000 IF(IJ)GO TO 12031
10100 C FOLLOWS UP ON POINTERS TO POINTERS!
10200 PM=1.
10300 IF(IJ.GT.1)GO TO 2157
10400 P(L)=0
10500 GO TO 21551
10600 C 7/73
10700 2157 LN=IJ+2
10800 NM=ABS(V(IJ-1))+LN-4
10900 NL=V(IJ)
11000 IF(NL.GT.-100)GO TO 272
11100 IF(NL.GT.-200)GO TO 372
11200 ISUB=-1
11300 NL=NL+200
11400 C FOR SUBROUTINE FLAG
11500 372 IF(NL.GT.-100)GO TO 272
11600 IDF=-1
11700 NL=NL+100
11800 C DEC.6,72 FINDS DUTY FACTOR PARAM
11900 272 VIJ2=V(IJ+1)
12000 KN=NL/(-11)
12100 IF(KN.EQ.0)GO TO 1100
12200 GO TO (61,62,62,62,65,65,67,68),KN
12300 1100 IF(VIJ2.EQ.1.)GO TO 1200
12400 ML=3
12500 1900 KA=1
12600 VX1=0
12700 DO 1156 K=LN,NM,ML
12800 VX(KA+1)=V(K)+VX(KA)
12900 1156 KA=KA+1
13000 X=RAND(0.0,1.)
13100 DO 1157 K=2,11
13200 IF(X.GT.VX(K))GO TO 1157
13300 KL=K-1
13400 IF(KN.EQ.7)GO TO 6157
13500 GO TO 1400
13600 1157 CONTINUE
13700 1400 LN=IJ+3*KL
13800 1462 RA=V(LN)
13900 IF(RA.EQ.10000.)GO TO 5174
14000 C FOR "FINE" IN RLIST
14100 RB=V(LN+1)
14200 PAR=RAND(RA,RB)
14300 1300 IF(NL.NE.-1)PM=2.
14400 C IF 2 THEN PRINTS A5
14500 GO TO 1155
14600 1200 PAR=V(IJ+2)
14700 GO TO 1300
14800 C NEXT IS FOR SUBROUTINE AND QUAD CALLS
14900 61 IF(NL.LT.-12)GO TO 6100
15000 601 X=P2
15100 C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
15200 CALL SUBR
15300 CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
15400 C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15500 IF(L.EQ.2)GO TO 4203
15600 IF(X.EQ.P2)GO TO 21552
15700 PP2=P2
15800 PR=P2
15900 GO TO 21552
16000 C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
16100 C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
16200 C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
16300 C BE SET TO 'REAL TIME'.)
16310 6100 IF(NL.EQ.-19)GO TO 6101
16400
16500 C NEXT IS FOR QUAD ROUTINES
16600 CALL QUAD(NL)
16700 GO TO 21552
16750 6101 COFF1(J)=V(LN)
16760 C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
16775 COFF2(J)=V(LN+1)
16780 GO TO 2155
16800
16900 C FOLLOWING IS FOR STRINGS OF VALUES.
17000 62 KL=NCNT(J,L)+1
17100 IF(KL.GT.VIJ2)KL=1
17200 IF(NL.EQ.-46)GO TO 677
17300 IF(NL.NE.-36)GO TO 162
17400 C THIS PART FOR STRINGS OF RAND SELECTION
17500 677 LN=KL+IJ+1
17600 KL=KL+1
17700 IF(KL.GT.VIJ2)KL=1
17800 NL=NL+45
17900 C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
18000 162 NCNT(J,L)=KL
18100 IF(NL.GT.-22)GO TO 1462
18200 C JUMP RAND SELECTION
18300 PAR=V(IJ+KL+1)
18400 C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18500 C************************
18600 IF(KN.NE.3)GO TO 1155
18700 C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
18800 IF(PAR.EQ.10000.)GO TO 5174
18900 PM=2.
19000 IF(PAR.GT.100.)GO TO 777
19100 IF(PAR.GE.1.)GO TO 877
19200 777 PM=3.
19300 877 IF(PAR.EQ.85.)MK=-1
19400 GO TO 5155
19500 65 W=-9900.-V(IJ-3)
19600 C W=BG TIME OF MOVE.
19700 X=ABS(V(IJ-1))
19800 IF(NL.EQ.-56)GO TO 977
19900 IF(NL.NE.-58)GO TO 771
20000 977 PM=2.
20100 771 Z=(BT-W)/VIJ2
20200 C Z= % OF WAY THROUGH.
20300 IF(Z.GT.1.)Z=1.
20400 Y=V(LN)
20500 W=V(IJ+3)
20600 IF(X.EQ.7.)W=V(IJ+4)
20700 IF(NL.LT.-58)GO TO 16002
20800 PAR=(W-Y)*Z+Y
20900 IF(X.EQ.7.)GO TO 1600
21000 GO TO 1155
21100 C************** JUNE 1,71
21200 C FOR "MOVX"
21300 C******** FEB/73
21400 C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
21500 16002 PAR=RMOVX(W,Y,Z)
21600 C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21700 C THIS NEEDS WORK!
21800 IF(X.NE.7.)GO TO 1155
21900 W=V(IJ+5)
22000 Y=V(IJ+3)
22100 X=RMOVX(W,Y,Z)
22200 GO TO 16003
22300 C NEXT IS FOR MOVING RAND RANGES.
22400 C1600 PAR=(V(IJ+4)-Y)*Z+Y
22500 1600 W=V(IJ+3)
22600 C*********** BACK TO 65 IS NEW. FEB. 15,71
22700 X=(V(IJ+5)-W)*Z+W
22800 C************ JUNE 1,71
22900 16003 PAR=RAND(PAR,X)
23000 GO TO 1155
23100 67 LN=IJ+3
23200 NM=LN+VIJ2-1
23300 ML=1
23400 GO TO 1900
23500 4155 K=(PAR-9999.0)*100.+.1
23600 P(L)=P(K)
23700 IF(L.NE.2)GO TO 772
23800 IF(K.EQ.2)P2=PX2
23900 C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
24000 772 PM=PL(K)
24100 GO TO 21551
24200 C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
24300 C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
24400 C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
24500 C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
24600 C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
24700 6157 LN=V(LN-1)
24800 DO 1068 K=1,KL
24900 1068 IF(K.LT.KL)LN=LN+V(LN)+1
25000 2068 PM=LN+1
25100 PAR=LN+V(LN)
25200 GO TO 5155
25300 68 KL=NCNT(J,L)
25400 IF(KL.EQ.0)GO TO 774
25500 IF(KL.NE.10000)GO TO 773
25600 774 KL=VIJ2
25700 773 PM=KL+1
25800 PAR=PM+V(KL)-1
25900 KL=PAR+1
26000 IF(V(KL).EQ.10000.)DUR(J)=BT
26100 C 'END' OR 'FINE' IN 'LIT' LIST.
26200 IF(V(KL).EQ.999.)KL=IJ+2
26300 NCNT(J,L)=KL
26400 GO TO 5155
26500 C ******* JAN 20 *************
26600 1155 IF(PAR.EQ.10000.)GO TO 5174
26700 C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
26800 IF(PAR.LE.9999.)GO TO 5155
26900 IF(PM.EQ.1.)GO TO 4155
27000 C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
27100 5155 P(L)=PAR
27200 21551 PL(L)=PM
27300 IF(ISUB)GO TO 601
27400 IF(L.EQ.2)GO TO 4203
27500 21552 IF(IDF.GE.0)GO TO 2155
27600 DF=PAR
27700 C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
27800 IDF=0
27900 2155 CONTINUE
28000
28100 9203 IF(KB.EQ.0)GO TO 1170
28200 NL=KB
28300 DO 2203 K=1,KB
28400 X=OTH(NL,1)
28500 IF(X.LT.100000.)GO TO 2203
28600 L=X/100000.
28700 Y=(X-L*100000.)/100.
28800 IX=Y
28900 JC=NL
29000 IF(J.NE.L)GO TO 2203
29100 IF(IX.EQ.ICT)GO TO 5203
29200 2203 NL=NL-1
29300 GO TO 1170
29310 4203 X=COFF1(J)
29320 IF(X.LE.BT)GO TO 6102
29330 C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
29340 CC IF(P2.NE.PX2)GO TO 2155
29350 C JUMP IF 'TEMPO' CHANGE
29360 IF(BT+P2.GT.X-COFF2(J))P2=X-BT
29400 6102 PR=P2
29500 PX2=P2
29600 C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
29700 IF(T5.EQ.0)GO TO 7203
29800 IF(IT3.LE.1)GO TO 6203
29900 IF(BT.LT.TBG+TDUR)GO TO 6203
30000 3155 IT3=IT3+3
30100 TBG=TBG+TDUR
30200 TDUR=V(IT3)
30300 IF(BT.GE.TBG+TDUR)GO TO 3155
30400 T1=V(IT3+1)
30500 T2=V(IT3+2)
30600 CALL SQYY(AC,T1,T2,TDUR)
30700 6203 RA=PR
30800 IF(BT.EQ.TBG)XT(J)=T1
30900 K=IT3
31000 RC=0
31100 C75 RD=1
31200 KA=1
31300 C75 RB=0
31400 Z=TDUR+TBG-BT
31500 X=T1
31600 Y=T2
31700 YY=AC
31800 CHN=TBG
31900 ZZ=TDUR
32000 CALL ACCEL
32100 8203 P2=RA*RD
32200 7203 P2=P2*T4
32300 X=P2*TF
32400 C P2 IS KEPT WITHOUT TF*
32500 K=X+.5
32600 IF(X)K=X-.5
32700 72031 ROFF(J)=ROFF(J)+K-X
32800 IF(ABS(ROFF(J)).LT.1.)GO TO 7155
32900 Y=1.
33000 IF(ROFF(J))Y=-Y
33100 K=K-Y
33200 ROFF(J)=ROFF(J)-Y
33300 C ROUND-OFF GAP WILL NOT EXCEED .001
33400 C*********** FEB 17,71
33500 7155 PP2=K/1000.
33600 C AVOIDS ROUND-OFF PROBLEMS
33700 C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
33800 IF(IPT(J,31).EQ.0)GO TO 6155
33900 IF(ICT)GO TO 1170
34000 X=V(IPT(J,31)+2)/2.
34100 Y=RAND(-X,X)
34200 IF(PP2.GE.0)GO TO 615
34300 MK=-1
34400 PP2=-PP2
34500 615 PP2=PP2-RDEV(J)+Y
34600 RDEV(J)=Y
34700 C TOTAL RAND DEV. WON'T EXCEED P31
34800 C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
34900
35000 K=PP2*1000.+.5
35100 C****** CHECK THIS OUT 1/10/72 :::::::
35200 61551 PP2=K/1000.
35300 C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
35400 6155 IF(ICT)GO TO 9203
35500 GO TO 2155
35600 5203 JD=Y*100-IX*100+.5
35700 IF(JD.GT.0)GO TO 3203
35800 M=0
35900 P1(J)=PP1+PP2
36000 GO TO 7021
36100 3203 P(JD)=OTH(JC,2)
36200 X=OTH(JC,3)
36300 IF(X.NE.1.)X=3.
36400 C 'EDITS' PRINT,NUM. OR 5 CHARS.
36500 PL(JD)=X
36600 C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
36700 IF(JD.EQ.2)PP2=P2
36800 C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
36900 1170 IF(MK)GO TO 2022
37000 IF(PP2)GO TO 2022
37100
37200 ZPAR=PP1
37300 P1(J)=PP1+PP2
37400 C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
37500 LK=INST(J)
37600 2021 IF(PP1.LT.OP1)GO TO 2612
37700 IF(INVIS(J).LT.0)GO TO 2170
37800 C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
37900 IF(INONLY.GT.0)GO TO 1204
38000 C*********** MAY 16,71 ↑↑↑
38100 6021 IF(P(NPA).NE.COPY(NPA))GO TO 5021
38200 IF(PL(NPA).GT.1)GO TO 5021
38300 C******* MAY 25,71
38400 C 'LIT' DATA WILL ALWAYS PRINT.
38500 NPA=NPA-1
38600 IF(NPA.GT.2)GO TO 6021
38700 5021 DO 1304 K=3,NPA
38800 1304 COPY(K)=P(K)
38900 1204 IF(PL4.NE.1.)GO TO 2170
39000 P4=P4*AMPFAC
39100 L=0
39200 INP(J)=P4
39300 DO 1021 K=1,NINS
39400 1021 IF(P1(K).GT.PP1)L=L+INP(K)
39500 IF(L-IAMP-1)GO TO 2170
39600 IAMP=L
39700 AMPTIM=PP1
39800 2170 IF(MX.EQ.3)GO TO 2612
39900 C ********* MAY 17,71
40000 PP1=PP1-OP1
40100 C PUTS SPACES BETWEEN NOTES .GT. .05( APART
40200 IF(MZ.NE.-1)GO TO 5170
40300 IF(A.GE.PP1)GO TO 5170
40400 IF(INONLY)WRITE(JOUT,902)
40500 A=PP1+.05
40600 5170 ML=10
40700 IF(NPA.LT.10)ML=NPA
40800 MLX=3
40900 NL=2
41000 IF(INVIS(J).EQ.0)GO TO 3170
41100 LK=0
41200 C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
41300 C NEXT CREATES FORMAT DATA IN IFM ARRAY.
41400 31701 KL=3
41500 GO TO 4170
41600 3170 IF(J.EQ.INONLY)GO TO 775
41700 IF(.NOT.INONLY)GO TO 2612
41800 775 VX(1)=PP1
41900 IF(DF.GT.0)GO TO 6170
41910 VX2=PP2+DF
41920 IF(VX2.LE.0)VX2=PP2/2
41930 C NO NEG. TIME VALUES ALLOWED.
42210 C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
42300 GO TO 7170
42400 6170 IF(DF.LT.100)GO TO 8170
42510 C DF+100=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
42600 VX2=DF-100.
42700 IF(VX2.GT.PP2)VX2=PP2
42900 GO TO 7170
43000 8170 VX2=PP2*DF
43100 7170 IFM3='F9.3,'
43200 IFM4=IFM3
43300 KL=5
43400 IF(NPA.LT.3)GO TO 2121
43500
43600 4170 NL=2
43700 DO 1121 K=MLX,ML
43800 X=P(K)
43900 L=PL(K)
44000 IF(L-2)321,521,621
44100 C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
44200 321 IF(X.GE.0)GO TO 4211
44300 IFM(KL)=IFCOM
44400 NL=NL+1
44500 KL=KL+1
44600 4211 IFM(KL)='F9.3,'
44700 C CREATES 'F9.3'
44800 421 VX(KL-NL)=X
44900 GO TO 1121
45000 521 IFM(KL)=IFM2
45100 C CREATES '1XA5'
45200 LN=X
45300 VX(KL-NL)=SCAL(LN)
45400 GO TO 42
45500 621 IF(L.GT.3)GO TO 721
45600 VX(KL-NL)=X
45700 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
45800 42 IFM(KL)=IFM2
45900 GO TO 1121
46000 721 LN=X
46100 IFM(KL)=I1X
46200 NL=NL+1
46300 DO 821 M=1,LN-L+1
46400 KL=KL+1
46500 IOUT(KL-NL)=IV(L-1+M)
46600 821 IFM(KL)=IA1
46700 1121 KL=KL+1
46800
46900 C NO MORE THAN 80 ITEMS IN FORMAT.
47000 2121 IF(KL.LE.80)GO TO 21211
47100 21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
47200 TYPE 21212
47300 21211 DO 921 M=KL+1,80
47400 921 IFM(M)=IBLA
47500 IFM(KL)=')'
47600 L=KL-NL-1
47700 IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
47800 IF(.NOT.MZ)GO TO 30210
47900 IF(ML.GE.NPA)IFM(KL)='$)'
48000 WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
48100 30210 IF(ML.GE.NPA)GO TO 3021
48200 MLX=ML+1
48300 ML=ML+10
48400 IF(ML.GT.NPA)ML=NPA
48500 LK=IBLA
48600 GO TO 31701
48700 3021 IF(MX)WRITE(1,3616)INST(J),ICT
48800 30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
48900 2612 PP1=ZPAR
49000 GO TO 21
49100 8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
49200 3616 FORMAT(';PRINT(P1);< ',A5,I4)
49300 C PRINTS RESTS
49400 2022 PP2=ABS(PP2)
49500 C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
49600 C FOR RESTS IN SEQS. TYPE -DUR.
49700 C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
49800 C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
49900 INP(J)=0
50000 P1(J)=PP1+PP2
50100 C STORES NEXT P1 TIME FOR THIS INST.
50200 IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
50300 X=PP1-OP1
50400 IF(A.GE.X)GO TO 121
50500 WRITE(JOUT,902)
50600 A=X+.05
50700 121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
50800 1 J,INST(J),ICT
50900 21 PR=ABS(PR)
51000 BG(J)=BT+PR
51100 IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
51200 IF(BG(J).LT.DUR(J))GO TO 500
51300 5174 BG(J)=19999.
51400 DO 3174 K=1,NINS
51500 C INSERTS CANT FOLLOW LAST REGULAR NOTE.
51600 C (ADD REST IF INSERT AT END IS NEEDED.)
51700 3174 IF(BG(K).LT.19999.)GO TO 500
51800 GO TO 175
51900 C CHOOSES INST WITH NEXT BEGIN TIME.
52000 500 J=1
52100 BW=BT
52200 NL=NINS+KB
52300 DO 22 K=2,NL
52400 22 IF(BG(J).GT.BG(K))J=K
52500 IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
52600 J=1
52700 DO 5022 K=2,NINS
52800 X=P1(J)
52900 Y=P1(K)+.0001
53000 C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
53100 IF(BG(J).EQ.19999.)X=19999.
53200 IF(BG(K).EQ.19999.)Y=19999.
53300 5022 IF(X.GT.Y)J=K
53400 C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
53500 3022 BT=BG(J)
53600 IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
53700 IF(CNT(J).GT.0)GO TO 1022
53800 IF(CNT(J).EQ.0)P1(J)=0
53900 IF(CNT(J).EQ.-1)CNT(J)=0
54000 C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
54100 1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
54200 T4=T2
54300 T5=0
54400 T6=10000.
54500 GO TO 1108
54600 1175 FORMAT('+',A5,'=',F7.3,2X,$)
54700 1109 FORMAT(' FINISH; < ',A5,'.DAT')
54800 1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
54900 1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
55000 1,F8.3)
55100 175 IF(MZ)WRITE(JOUT,1109),ISLAC
55200 IF(MX.GE.0)GO TO 4175
55300 WRITE(1,1109),ISLAC
55400 END FILE 1
55450 TYPE 60003
55475 60003 FORMAT(' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
55500 603 FORMAT(' TOTAL DURS: ',$)
55600 CC FOR COLGATE ONLY***4175 CALL ENDSUB
55700 C CLEARS CNTL O --- IF YOU HAVE HIT IT.
55800 4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
55900 WRITE(JOUT,603)
56000 5175 DO 2175 K=1,NINS
56100 X=P1(K)-OP1
56200 IF(MZ)GO TO 6175
56300 TYPE 1175,INST(K),X
56400 GO TO 2175
56500 6175 WRITE(JOUT,1175),INST(K),X
56600 2175 CONTINUE
56700 IF(JOUT.NE.22)GO TO 3175
56800 END FILE 22
56900 CALL PRINT
57000 REWIND 22
57100 K='FOR22'
57200 CALL OFILE(22,K)
57300 END FILE 22
57400 3175 TYPE 1023,ISLAC,IXIN
57500 CALL EXIT
57600 END